home *** CD-ROM | disk | FTP | other *** search
/ Ham Radio 2000 #1 / Ham Radio 2000.iso / ham2000 / packet / p_aa4re / bb212src / bbfwdc.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-01-19  |  10.8 KB  |  348 lines
  1. (*===========================================================================*)
  2. (* Clean up message routing                                                  *)
  3. (*                                                                           *)
  4. (*   Copyright 1990, 1991, 1992 by H. Roy Engehausen.  All rights reserved.  *)
  5. (*                                                                           *)
  6. (*===========================================================================*)
  7.  
  8. {$O+}
  9.  
  10. {$DEFINE POINT_CHK}
  11. {$DEFINE FREE_CHK}
  12.  
  13. UNIT BBFWDC;
  14.  
  15. INTERFACE
  16.  
  17.   USES
  18.     bbdummy,
  19.     bbfwdd;
  20.  
  21.   PROCEDURE fwd_route_clean_msg(this_msg  : msg_index_ptr);
  22.  
  23.   PROCEDURE fwd_route_mark_done(path_data : path_block_ptr);
  24.  
  25.   PROCEDURE fwd_route_clean_empty_route;
  26.  
  27.   PROCEDURE fwd_route_reset(this_blk : msg_r_ptr);
  28.  
  29. IMPLEMENTATION
  30.  
  31.   USES
  32.     bbbpa,
  33.     bbdump,
  34.     bbfnr,
  35.     bbmem,
  36.     bbmf,
  37.     bbmisc3,
  38.     bbstr;
  39.  
  40. (*===========================================================================*)
  41. (* Clean up forward pointers in a message                                    *)
  42. (*===========================================================================*)
  43.  
  44. PROCEDURE fwd_route_clean_msg(this_msg : msg_index_ptr);
  45.  
  46.   VAR
  47.     i            : WORD;
  48.     num_dis      : BYTE;
  49.     this_dr      : msg_dr_ptr;
  50.     this_flag    : msg_flag_type;
  51.  
  52.   {$UNDEF DEBUG_1}
  53.   {$UNDEF DEBUG_2}
  54.  
  55.   BEGIN;
  56.  
  57.     {$IFDEF POINT_CHK}
  58.       test_pointer(this_msg);
  59.     {$ENDIF}
  60.  
  61.     (*-----------------------------------------------------------------------*)
  62.     (* Get the flag to be handy                                              *)
  63.     (*-----------------------------------------------------------------------*)
  64.  
  65.     this_flag := this_msg^.msg_i_mb.msg_flag;
  66.  
  67.     (*-----------------------------------------------------------------------*)
  68.     (* If no distribution list then just remove pointer else lots of work    *)
  69.     (*-----------------------------------------------------------------------*)
  70.  
  71.     IF (this_flag AND mf_fwd_list) = 0 THEN
  72.       this_msg^.msg_i_rou := NIL
  73.     ELSE
  74.       BEGIN;
  75.  
  76.         (*-------------------------------------------------------------------*)
  77.         (* If the distrbution route block is present then we erase it and    *)
  78.         (* clean up chaining.                                                *)
  79.         (*-------------------------------------------------------------------*)
  80.  
  81.         IF (this_flag AND mf_disrout) <> 0 THEN
  82.           BEGIN;
  83.  
  84.             {$IFDEF DEBUG_2}
  85.               WRITELN('DR block clean -- ', this_msg^.msg_i_mb.msg_number);
  86.             {$ENDIF}
  87.  
  88.             this_dr   := this_msg^.msg_i_dr;
  89.  
  90.             {$IFDEF POINT_CHK}
  91.               test_pointer(this_dr);
  92.               test_pointer(this_dr^.msg_dr_dblk);
  93.             {$ENDIF}
  94.  
  95.             this_msg^.msg_i_dis := this_dr^.msg_dr_dblk;
  96.             num_dis             := this_msg^.msg_i_dis^.msg_d_no;
  97.  
  98.             IF num_dis > msg_dist_max THEN
  99.               BEGIN;
  100.                 dump_reason('FWDC1 Invalid distribution # -- ' + w2c(num_dis));
  101.                 dump_reason('M # = ' + w2c(this_msg^.msg_i_mb.msg_number));
  102.                 dump_all;
  103.                 HALT;
  104.               END;
  105.  
  106.             FREEMEM(this_dr, SIZEOF(msg_d_ptr)
  107.                                   + WORD(num_dis) * SIZEOF(msg_dr_route_item));
  108.  
  109.             {$IFDEF FREE_CHECK}
  110.               test_free_list;
  111.             {$ENDIF}
  112.  
  113.           END;
  114.  
  115.         (*-------------------------------------------------------------------*)
  116.         (* If the distrbution block is present then we erase it              *)
  117.         (*-------------------------------------------------------------------*)
  118.  
  119.         IF this_msg^.msg_i_dis <> NIL THEN
  120.           BEGIN;
  121.  
  122.             {$IFDEF POINT_CHK}
  123.               test_pointer(this_msg^.msg_i_dis);
  124.             {$ENDIF}
  125.  
  126.             num_dis  := this_msg^.msg_i_dis^.msg_d_no;
  127.             i        := 1 + WORD(num_dis) * SIZEOF(msg_dist_entry_type);
  128.  
  129.             IF num_dis > msg_dist_max THEN
  130.               BEGIN;
  131.                 dump_reason('FWDC2 Invalid distribution # -- ' + w2c(num_dis));
  132.                 dump_reason('M # = ' + w2c(this_msg^.msg_i_mb.msg_number));
  133.                 dump_all;
  134.                 HALT;
  135.               END;
  136.  
  137.             {$IFDEF DEBUG_2}
  138.               WRITELN('D block clean -- ', this_msg^.msg_i_mb.msg_number,
  139.                       ' -- ', num_dis);
  140.             {$ENDIF}
  141.  
  142.             FREEMEM(this_msg^.msg_i_dis, i);
  143.             this_msg^.msg_i_dis := NIL;
  144.  
  145.             {$IFDEF FREE_CHECK}
  146.               test_free_list;
  147.             {$ENDIF}
  148.  
  149.           END;
  150.  
  151.       END;
  152.  
  153.     (*-----------------------------------------------------------------------*)
  154.     (* Remove certain flags                                                  *)
  155.     (*-----------------------------------------------------------------------*)
  156.  
  157.     this_msg^.msg_i_mb.msg_flag := this_flag
  158.                AND NOT (mf_fwd_select OR mf_fwd_process
  159.                                                   OR mf_disrout OR mf_unknown);
  160.  
  161.   END;
  162.  
  163. (*===========================================================================*)
  164. (* Mark all routes as used                                                   *)
  165. (*===========================================================================*)
  166.  
  167. PROCEDURE fwd_route_mark_done(path_data  : path_block_ptr);
  168.  
  169.   VAR
  170.     bpa_route   : bpa_route_used_type;
  171.     this_blk    : msg_r_ptr;
  172.  
  173.   LABEL
  174.     start_here;
  175.  
  176.   BEGIN;
  177.  
  178.     GOTO start_here;
  179.  
  180.     WHILE bpa_route <> NIL DO
  181.       BEGIN;
  182.  
  183.         (*-------------------------------------------------------------------*)
  184.         (* Validate pointers                                                 *)
  185.         (*-------------------------------------------------------------------*)
  186.  
  187.         {$IFDEF POINT_CHK}
  188.           test_pointer(bpa_route);
  189.         {$ENDIF}
  190.  
  191.         (*-------------------------------------------------------------------*)
  192.         (* Make sure this is a valid and current route block.  It might      *)
  193.         (* have disappeared because of a valid reason                        *)
  194.         (*-------------------------------------------------------------------*)
  195.  
  196.         this_blk := msg_route_list;
  197.  
  198.         WHILE (this_blk <> NIL) AND (this_blk <> bpa_route^) DO
  199.           BEGIN;
  200.             {$IFDEF POINT_CHK}
  201.               test_pointer(this_blk);
  202.             {$ENDIF}
  203.             this_blk := this_blk^.msg_r_next;
  204.           END;
  205.  
  206.         (*-------------------------------------------------------------------*)
  207.         (* If the route block still exists then reset it                     *)
  208.         (*-------------------------------------------------------------------*)
  209.  
  210.         IF this_blk <> NIL THEN
  211.           BEGIN;
  212.             {$IFDEF POINT_CHK}
  213.               test_pointer(this_blk);
  214.             {$ENDIF}
  215.             fwd_route_reset(this_blk);
  216.           END;
  217.  
  218.         (*-------------------------------------------------------------------*)
  219.         (* Free the memory control block                                     *)
  220.         (*-------------------------------------------------------------------*)
  221.  
  222.         free_task_mem(path_block_lst_id, FALSE);
  223.  
  224.         (*-------------------------------------------------------------------*)
  225.         (* Find next/first block                                             *)
  226.         (*-------------------------------------------------------------------*)
  227.  
  228. start_here:
  229.  
  230.         bpa_route := find_task_mem_addr(path_block_lst_id);
  231.  
  232.       END;
  233.  
  234.   END;
  235.  
  236. (*===========================================================================*)
  237. (* Clean up routes that are empty only                                       *)
  238. (*===========================================================================*)
  239.  
  240. PROCEDURE fwd_route_clean_empty_route;
  241.  
  242.   VAR
  243.     inx          : BYTE;
  244.     next_route   : msg_r_ptr;
  245.     this_msg     : msg_index_ptr;
  246.     last_route   : msg_r_ptr;
  247.     this_route   : msg_r_ptr;
  248.  
  249.   BEGIN;
  250.  
  251.     (*-----------------------------------------------------------------------*)
  252.     (* Initialize                                                            *)
  253.     (*-----------------------------------------------------------------------*)
  254.  
  255.     last_route := NIL;
  256.     next_route := msg_route_list;
  257.  
  258.     (*-----------------------------------------------------------------------*)
  259.     (* Loop thru routes                                                      *)
  260.     (*-----------------------------------------------------------------------*)
  261.  
  262.     WHILE next_route <> NIL DO
  263.       BEGIN;
  264.  
  265.         {$IFDEF POINT_CHK}
  266.           test_pointer(next_route);
  267.         {$ENDIF}
  268.  
  269.         (*-------------------------------------------------------------------*)
  270.         (* Set up chaining to next route                                     *)
  271.         (*-------------------------------------------------------------------*)
  272.  
  273.         this_route := next_route;
  274.         next_route := this_route^.msg_r_next;
  275.  
  276.         (*-------------------------------------------------------------------*)
  277.         (* Any messages queued?                                              *)
  278.         (*-------------------------------------------------------------------*)
  279.  
  280.         this_msg := find_next_msg(this_route, NIL, inx);
  281.  
  282.         (*-------------------------------------------------------------------*)
  283.         (* If no messages queued then destroy the route else finish chaining *)
  284.         (*-------------------------------------------------------------------*)
  285.  
  286.         IF this_msg = NIL THEN
  287.           BEGIN;
  288.             DISPOSE(this_route);
  289.  
  290.             {$IFDEF FREE_CHECK}
  291.               test_free_list;
  292.             {$ENDIF}
  293.  
  294.             IF last_route = NIL THEN
  295.               msg_route_list := next_route
  296.             ELSE
  297.               last_route^.msg_r_next := next_route;
  298.  
  299.           END
  300.         ELSE
  301.           last_route := this_route;
  302.  
  303.       END; (*----- End of free route list loop ------------------------------*)
  304.  
  305.   END;
  306.  
  307. (*===========================================================================*)
  308. (* Reset a message block back to the beginning                              *)
  309. (*===========================================================================*)
  310.  
  311. PROCEDURE fwd_route_reset(this_blk : msg_r_ptr);
  312.  
  313.   VAR
  314.     i : BYTE;
  315.     j : BYTE;
  316.  
  317.   FUNCTION test_number(s : str4) : BOOLEAN;
  318.  
  319.     VAR
  320.       code : INTEGER;
  321.       i    : INTEGER;
  322.  
  323.     BEGIN;
  324.  
  325.       test_number := FALSE;
  326.       IF (LENGTH(s) > 3) OR (s = '') THEN EXIT;
  327.  
  328.       VAL(s, i, code);
  329.  
  330.       IF (code <> 0) OR (i < 0) THEN EXIT;
  331.       test_number := TRUE;
  332.  
  333.     END;
  334.  
  335.   BEGIN;
  336.  
  337.     i := 1;
  338.     j := this_blk^.msg_r_routes;
  339.  
  340.     WHILE (i < j) AND test_number(subword(@this_blk^.msg_r_info, i, 1)) DO
  341.       INC(i);
  342.  
  343.     this_blk^.msg_r_nroute := i;
  344.  
  345.   END;
  346.  
  347. END.
  348.